library ResourceManager;

uses sysutils, classes, LibXMLParser, CoreI, ResourceManagerI, Resource;
const signature = $52455741;
NamespaceDelim = '.';
var PluginInfo:PPluginInfo;
Packages:TStringList;
function CreateResource(const name,FileName:string; const ResType:TResourceType; const standalone:boolean; const stream:TFileStream=nil):TResource;
var f:file;
i:cardinal;
begin
result := TResource.create;
           result.Name := name;
           result.FileName := fileName;
           result.ResType := ResType;
           if FileName='' then exit;
           if standalone then begin
//load from file
assign(f, result.FileName);
reset(f, 1);
result.RawDataSize := FileSize(f);
result.allocMem;
blockread(f, result.rawData^, result.RawDataSize);
close(f);
           end else begin
stream.Read(i, sizeof(i));
result.RawDataSize := i;
stream.Read(result.rawData^, result.RawDataSize);
           end;
end;

Procedure LoadPackage(const name:PChar; const initResources:boolean=true); cdecl;
var r:TResource;
l:TObject;
s:TFileStream;
parser:TXMLParser;
i:cardinal;
standalone:boolean;
Procedure ParseResource;
var
name,fileName:string;
ResType:integer;
begin
case parser.CurPartType of
PTStartTag: begin
name := parser.CurAttr.Value('name');
if name = '' then raise exception.Create('error while parsing index resource: name attribute not found') else
FileName := parser.CurAttr.Value('filename');
if not standalone and (not fileexists(FileName)) then raise exception.CreateFmt('File ''%s'' not found!', [r.FileName]);
try
ResType := StrToInt(parser.CurAttr.Value('type'));
except
raise exception.CreateFmt('Error while parsing Resource type: %s is not integer value', [parser.CurAttr.Value('type')]);
end;
r := CreateResource(name, fileName, ResType, standalone, s);
end;
PTEndTag: begin
if l is TNamespace then (l as TNamespace).list.AddObject(r.Name, r) else
(l as TStringList).AddObject(r.Name, r);
                  if initResources then r.Init;
end;
end;
end;
var MultilingualStr:TMultilingualString;
CurParam:string;
procedure ParseParams;
begin
case parser.CurPartType of
PTStartTag: begin
MultilingualSTR := nil;
CurParam := parser.CurAttr.Value('name');
if CurParam= '' then raise exception.Create('name attribute expected');
end;
PTContent: CurParam := CurParam + '=' + parser.CurContent;
PTEndTag: begin
if MultilingualStr = nil then
r.Params.Add(CurParam) else
r.Params.AddObject(CurParam, MultilingualStr);
MultilingualSTR := nil;
end;
end;
end;
Procedure ParseNamespace;
var s:string;
t:TNamespace;
begin
case parser.CurPartType of
PTStartTag: begin
s := parser.CurAttr.Value('name');
if s = '' then raise exception.Create('error while parsing namespace: name attribute not found');
t := TNamespace.create(s, l);
if l is TNamespace then (l as TNamespace).list.AddObject(s, t) else
(l as TStringList).AddObject(s, t);
l:=t;
end;
PTEndTag:
if l is TNamespace then
l := (l as TNamespace).parent;
end;
end;
procedure ParseLangParts;
begin
case parser.CurPartType of
           PTContent: begin
MultiLingualStr.AddString(parser.CurName, parser.CurContent);
end;
end;
end;
                       var InMultiLingual : boolean;
procedure ParseMultilingualString;
begin
case parser.CurPartType of
PTStartTag: begin
MultiLingualStr := TMultiLingualString.create;
InMultiLingual := true;
end;
PtEndTag: InMultiLingual := false;
end;
end;
var index:integer;
buf:PChar;
begin
InMultiLingual := false;
standalone := true;
index := packages.IndexOf(name);
if index > -1 then begin
log_writeF('Resource Manager: LoadPackage: Warning: package ''%s'' already loaded', ll_warn, [name]);
exit;
                end;
if not FileExists(name) then begin
core_error(PChar('LoadPackage: file not found ''' + name + ''''), ECore_Main);
exit;
end;
parser := TXMLParser.Create;
s := nil;
try //finally
try
s := TFileStream.Create(name, fmOpenRead);
           s.Read(i, sizeof(signature));
if i = signature then standalone := false;
if not standalone then s.Read(i, sizeof(i)) else i := s.Size;
if i = 0 then exit;
getmem(buf, i + 1);
if standalone then s.Position := 0;
                 s.Read(buf^, i);
byte(pointer(cardinal(buf) + i)^) := 0;
parser.SetBuffer(buf);
l := TStringList.Create;
            packages.AddObject(name, l);
//(l as TStringList).AddObject(r.Name, r);
while parser.Scan do begin
if parser.CurName = 'namespace' then ParseNamespace else
if parser.CurName = 'resource' then
ParseResource else
if parser.CurName = 'param' then ParseParams else
if parser.CurName = 'str' then parseMultilingualString
else if InMultiLingual then ParseLangParts;
end;
parser.Free;
freemem(buf);
                   except
on e:exception do core_error(pchar('LoadPackage: ' + e.Message+ ' (package ''' + name + ''''), ECore_Main);
end;
finally
s.Free;
end;
                end;

                Procedure UnloadPackage(const name:PChar); cdecl;
var index,i:integer;
                begin
index := packages.IndexOf(name);
if index = -1 then begin
log_writeF('UnloadPackage: warning: package ''%s'' not found.', ll_warn, [name]);
exit;
end;
for i := 0 to (packages.Objects[index] as TStringList).Count -1 do
(packages.Objects[index] as TStringList).Objects[i].Free;
(packages.Objects[index] as TStringList).Free;
packages.Delete(index);
end;

    Function GetStrBeforeDelim(var s:string; const  delim:string=NamespaceDelim):string;
var i:integer;
begin
i := pos(delim, s);
if i > 0 then result := copy(s, 1, i -1) else result:= s;
delete(s, 1, length(result)+ length(delim));
end;

Function GetResource(const FullName:PChar; const ResType:TResourceType=RT_Unknown):pointer; cdecl;
var CurName:string;
function FindResource(const l:TStringList):TResource;
var i:integer;
s,c:string;
begin
result:=nil;
c:=CurName;
                                                                  s := GetStrBeforeDelim(CurName);
                                                                  i := l.IndexOf(s);
if i > -1 then begin
if (l.objects[i] is TResource) and (TResource(l.Objects[i]).ResType = ResType) then begin
result := ((l as TStringList).objects[i] as TResource);
exit;
end else if l.Objects[i] is TNamespace then
result := FindResource((l.objects[i] as TNamespace).list);
end else CurName := c;
                                                                  end;

          var i:integer;
begin
result:=nil;
CurName:=FullName;
for i := 0 to packages.Count -1 do begin
result := FindResource((packages.objects[i] as TStringList));
if result <> nil then break;
CurName := fullName;
end;
                end;

function AddResource(const package,ResourceName,FileName:PChar; const ResType:TResourceType):pointer; cdecl;
                var i:integer;
Find:TStringList;
Name:string;
FullName:string;
r:TResource;
procedure ProceedNamespace;
var i:integer;
n:TNamespace;
begin
name := GetStrBeforeDelim(FullName);
if FullName = '' then exit;
i := find.IndexOf(name);
if i= -1 then begin
             n := TNamespace.create(name, find);
find.AddObject(name, n);
             find := n.list;
             end else if find.Objects[i] is TNamespace then find := TNamespace(find.Objects[i]).list;
             ProceedNamespace;
             end;
                                begin
                                result := nil;
if GetResource(ResourceName, ResType) <> nil then begin
Core_Error('AddResource: Resource with such name already exists', ECore_Main);
exit;
end;
i := Packages.IndexOf(package);
if i = -1 then begin
{core_error('AddResource: package not exists', ECore_Main);
exit;}
i := Packages.AddObject(Package, TStringList.Create);
end;
name := ResourceName;
                                FullName := ResourceName;
                 find := TStringList(packages.objects[i]);
                 if pos(NamespaceDelim, ResourceName) > 0 then ProceedNamespace;
r := CreateResource(Name, FileName, ResType, true);
find.AddObject(name, r);
                 end;

Function GetResourceData(const res:pointer):pointer; cdecl;
begin
if TObject(res) is TResource then result := (TObject(Res) as TResource).Data else
result := nil;
end;
Function GetResourceSize(const res:pointer):cardinal; cdecl;
begin
if TObject(res) is TResource then result := (TObject(Res) as TResource).RawDataSize else
result := 0;
end;
Function GetResourceType(const res:pointer):TResourceType;
begin
if TObject(res) is TResource then result := (TObject(Res) as TResource).ResType else
result := RT_Unknown;
end;

    Procedure SavePackage(const name:PChar; const standalone:boolean); cdecl;
var s:TFileStream;
i:integer;
j:cardinal;
str:string;
Procedure SaveResource(const r:TResource);
begin
                                          if r.FileName = '' then exit;
                                          if standalone then r.SaveToFile else begin
s.Write(r.rawDataSize, sizeof(r.RawDataSize));
                                          s.Write(r.rawData^, r.RawDataSize);
                                          end;
end;
Procedure SaveList(const l:TStringList);
var i:integer;
begin
              for i := 0 to l.Count -1 do
              if l.Objects[i] is TResource then SaveResource(TResource(l.Objects[i])) else
              SaveList(TNamespace(l.Objects[i]).list);
              end;
var sign:cardinal;
    begin
if Packages = nil then exit;
          i := Packages.IndexOf(name);
if i = -1 then begin
core_error(PChar(Format('SavePackage: package ''%s'' not exists', [name])), ECore_Main);
exit;
end;
    s := TFileStream.Create(name, FMOpenWrite or FMCreate);
str := '<?xml version="1.0"?>'#13#10;
str := str + '<package>'#13#10;
   for j := 0 to TStringList(Packages.Objects[i]).Count -1 do
           str := str + TXMLSaveable(TStringList(Packages.Objects[i]).Objects[j]).XMLRepresentation;
str := str + '</package>';
           str := AnsiToUtf8(str);
           j := length(str);
                            if not standalone then begin
                            sign := signature;
                            s.Write(Sign, sizeof(signature));
                            s.Write(j, sizeof(j));
end;
           s.Write(PChar(str)^, j);
SaveList(TStringList(Packages.objects[i]));
           s.Free;
    end;
Function GetParamsCount(const r:pointer):integer; cdecl;
    begin
                 if TObject(r) is TResource then result := TResource(r).Params.Count else result := -1;
    end;

    procedure AddParam(const r:pointer; const paramName,ParamValue:PChar); cdecl;
        begin
if TObject(r) is TResource then
if TResource(r).Params.Values[ParamName] <> '' then TResource(r).Params.Values[ParamName] := ParamValue else
TResource(r).Params.Add(ParamName + TResource(r).Params.NameValueSeparator + ParamValue);
end;

                procedure Init; cdecl;
begin
SetCurrentDir(ExtractFileDir(Paramstr(0)));
packages := TStringList.Create;
end;

Procedure Free; cdecl;
var i,j:integer;
begin
for i := 0 to packages.Count -1 do begin
for j := 0 to (packages.Objects[i] as TStringList).Count -1 do
(packages.Objects[i] as TStringList).Objects[j].Free;
(Packages.Objects[i] as TStringList).Free;
end;
packages.Free;
dispose(IResourceManager(PluginInfo^.InterfaceStruct));
end;

Procedure Plugin_GetInfo(var info:PPluginInfo; var length:cardinal); cdecl;
begin
length := 1;
new(info);
PluginInfo := Info;
FillChar(info^, sizeof(TPluginInfo), 0);
info^.GUID := ResourceManagerGUID;
info^.Name := 'Resource Manager';
info^.Init := Init;
info^.free := Free;
new(IResourceManager(Info^.InterfaceStruct));
IResourceManager(info^.InterfaceStruct)^.AddResourceHandler := AddResourceHandler;
IResourceManager(info^.InterfaceStruct)^.LoadPackage := LoadPackage;
IResourceManager(info^.InterfaceStruct)^.UnloadPackage := UnloadPackage;
IResourceManager(info^.InterfaceStruct)^.GetResource := GetResource;
IResourceManager(info^.InterfaceStruct)^.GetResourceData := GetResourceData;
IResourceManager(info^.InterfaceStruct)^.GetResourceSize := GetResourceSize;
IResourceManager(info^.InterfaceStruct)^.GetResourceType := GetResourceType;
IResourceManager(info^.InterfaceStruct)^.SavePackage := SavePackage;
IResourceManager(info^.InterfaceStruct)^.AddResource := AddResource;
IResourceManager(info^.InterfaceStruct)^.AddParam := AddParam;
end;

exports Plugin_GetInfo;
begin
end.
